home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0188.ZIP / ITRMDIAL.INC < prev    next >
Text File  |  1985-02-20  |  8KB  |  278 lines
  1.  
  2. Const
  3.      MAXPHONES = 20;                   {maximum # of phone dir entries}
  4.      PHONE_FILE_NAME = 'ITERM.PHN';     {phone directory}
  5.      HAYES_INIT = 'AT V0';
  6.      DIAL_COMMAND = 'AT DT';
  7. Type
  8.     PhoneEntry       = record
  9.                        name : string[20];
  10.                        number : string[14];
  11.                        dir_baud : integer;
  12.                        dir_dbits : 7..8;
  13.                        dir_stop_bits : 1..2;
  14.                        dir_parity : parity_set;
  15.                        id : string[20];
  16.                        pw : string[20];
  17.                        paced : boolean;
  18.                        FilterSet : cset;
  19.                        end;
  20. Var
  21.    phones                : array[1..MAXPHONES] of PhoneEntry;
  22.    phfile                : file of PhoneEntry;
  23.    cflag                 : boolean;    {flag change in phone directory}
  24.    CurPhone              : Integer;
  25.  
  26. function getword(var s : bigstring; i : integer; var out : bigstring) : integer;
  27. { get word from s[i] into out }
  28. const
  29.      BLANK = ' ';
  30.      TAB = #09;
  31.      COMMA = ',';
  32. begin
  33.     out := '';
  34.     while (s[i] in [BLANK, TAB, COMMA]) and (i <= length(s)) do
  35.         i := i + 1;
  36.     while (not (s[i] in [BLANK, TAB, COMMA])) and (i <= length(s)) do
  37.     begin
  38.         out := out + s[i];
  39.         i := i + 1
  40.     end;
  41.     if i < length(s) then
  42.        getword := i
  43.     else
  44.        getword := 0
  45. end;
  46.  
  47. procedure MakeFilter(var b: bigstring; var c : cset);
  48. var bb : integer;
  49.     junk : integer;
  50. begin
  51.      val(b, bb, junk);
  52.      if (junk = 0) and (bb <= 127) then
  53.         c := c + [bb]
  54. end;
  55.  
  56.  
  57. procedure GetParms;
  58. var
  59.    p : string[4];
  60. begin
  61.      writeln('Current Parameters:');
  62.      writeln('Baud Rate:',speed:6);
  63.      writeln('Data Bits:',dbits:6);
  64.      writeln('Stop Bits:',stop_bits:6);
  65.      case parity of
  66.           even : p := 'EVEN';
  67.           none : p := 'NONE';
  68.           else   p := '????'
  69.      end;
  70.      writeln('Parity:   ',p:6);
  71.      writeln;
  72.      write('Change? (Y/N) ');
  73.      readln(p);
  74.      if length(p) > 0 then
  75.         if upcase(p) = 'Y' then
  76.         begin
  77.           write('New Baud Rate (<cr> to keep): ');
  78.           readln(speed);
  79.           write('New Data Bits (<cr> to keep): ');
  80.           readln(dbits);
  81.           write('New Stop Bits (<cr> to keep): ');
  82.           readln(stop_bits);
  83.           write('New Parity (E or N or <cr> to keep): ');
  84.           readln(p);
  85.           if length(p) > 0 then
  86.              case upcase(p) of
  87.                'E' : parity := even;
  88.                else parity := none;
  89.              end
  90.      end
  91. end;
  92.  
  93. procedure NewParms;
  94. begin
  95.      OpenTemp(20,7,60,22,2);
  96.      GetParms;
  97.      CloseTemp;
  98.      update_uart;
  99.      New_Baud(speed)
  100. end;
  101.  
  102. procedure InitPhn;
  103. var
  104.    i : integer;
  105. begin
  106.      cflag := false;
  107.      term_ready(TRUE);
  108.      assign(phfile,PHONE_FILE_NAME);
  109.      if exists(PHONE_FILE_NAME) then
  110.      begin
  111.         reset(phfile);
  112.         for i := 1 to MAXPHONES do
  113.              read(phfile, phones[i])
  114.      end
  115.      else
  116.      begin
  117.         rewrite(phfile);
  118.         with phones[1] do
  119.         begin
  120.              name := '';
  121.              number := '';
  122.              dir_baud := 300;
  123.              dir_dbits := 7;
  124.              dir_stop_bits := 1;
  125.              dir_parity := even;
  126.              id := '';
  127.              pw := '';
  128.              paced := TRUE;
  129.              FilterSet := []
  130.         end;
  131.         for i := 1 to MAXPHONES do
  132.         begin
  133.             phones[i] := phones[1];
  134.             write(phfile, phones[1])
  135.         end
  136.      end;
  137.      close(phfile)
  138. end;
  139.  
  140. procedure ListPhones;
  141. var
  142.    i : integer;
  143. begin
  144.      for i := 1 to MAXPHONES div 2 do
  145.      begin
  146.           write(i:2, ': ', phones[i].name);
  147.           GotoXY(40,WhereY);
  148.           writeln(i+MAXPHONES div 2:2,': ', phones[i + MAXPHONES div 2].name)
  149.      end
  150. end;
  151.  
  152. procedure DialModem(entry : integer);
  153. var
  154.    i : integer;
  155.    UserBrk : char;
  156. begin
  157.      speed := phones[entry].dir_baud;
  158.      dbits := phones[entry].dir_dbits;
  159.      stop_bits := phones[entry].dir_stop_bits;
  160.      parity := phones[entry].dir_parity;
  161.      DiscardSet := phones[entry].FilterSet;
  162.      update_uart;
  163.      new_baud(speed);
  164.      StrSend(HAYES_INIT);
  165.      StrSend(DIAL_COMMAND);
  166.      StrSend(phones[entry].number);
  167.      purge;
  168.      send(13);
  169.      i := cgetc(1);
  170.      status(2,'Awaiting Remote');
  171.      repeat
  172.            i := cgetc(0);
  173.            if KeyPressed then
  174.              read(kbd,UserBrk);
  175.      until (i <> -1) or (UserBrk = ^X);
  176.      write(#13,#10, phones[entry].name);
  177.      if (i and $7F) = $31 {'1'} then
  178.        begin
  179.             status(2,'On-Line/Ready');
  180.             writeln(' Connected.')
  181.        end
  182.      else
  183.        begin
  184.           status(2,'Off-Line/Ready');
  185.           case UserBrk of
  186.              ^X : begin
  187.                     Writeln(' -- Call interrupted.');
  188.                     send(13); send(13); purge;
  189.                   end;
  190.             else writeln(' Does not answer.')
  191.           end
  192.        end;
  193.      purge
  194. end;
  195.  
  196. {$V-}
  197.  
  198. Procedure Auto_Dial;
  199. type
  200.     str40 = string[40];
  201. var
  202.    i,valcode : integer;
  203.    c : string[2];
  204.    newset, element : bigstring;
  205.  
  206. Procedure ChangeOption(prompt : str40; var s : str40);
  207. var
  208.    temp : str40;
  209. begin
  210.      writeln('Current ',prompt,': ',s);
  211.      write(prompt,' (<cr> to keep): '); readln(temp);
  212.      if Length(temp) > 0 then
  213.         s := temp
  214. end;
  215.  
  216. begin
  217.      OpenTemp(10,5,70,19,2);
  218.      ListPhones;
  219.      write('Enter number to dial, (C)hange or <cr> to Quit  --> ');
  220.      readln(c);
  221.      val(c, Curphone, valcode);
  222.      if length(c) = 0 then
  223.         CloseTemp
  224.      else if valcode > 0 then
  225.      begin
  226.           repeat
  227.                 write('Enter line number to change --> ');
  228.                 readln(CurPhone);
  229.           until (CurPhone > 0) and (CurPhone <= MAXPHONES);
  230.           with phones[CurPhone] do
  231.           begin
  232.                writeln;
  233.                ChangeOption('Name',name);
  234.                ChangeOption('Phone', number);
  235.                GetParms;
  236.                writeln;
  237.                dir_baud := speed;
  238.                dir_dbits := dbits;
  239.                dir_stop_bits := stop_bits;
  240.                dir_parity := parity;
  241.                ChangeOption('User ID', id);
  242.                ChangeOption('Password', pw);
  243.                write('Need echo on macros? (Y/N; default Y)');
  244.                readln(c);
  245.                paced := TRUE;
  246.                if length(c) > 0 then
  247.                   if upcase(c[1]) = 'N' then
  248.                      paced := FALSE;
  249.                cflag := TRUE;
  250.                writeln;
  251.                writeln('Now filtering:');
  252.                for i := 1 to 127 do
  253.                   if i in FilterSet then
  254.                      write(i,',');
  255.                writeln; write('Enter a new list of ASCII codes to filter,');
  256.                writeln('or <cr> to keep the current set.');
  257.                write('? '); readln(newset);
  258.                if length(newset) > 0 then
  259.                begin
  260.                     i := 1;
  261.                     while i > 0 do
  262.                     begin
  263.                          i := getword(newset,i,element);
  264.                          MakeFilter(element,FilterSet)
  265.                     end
  266.                end;
  267.                CloseTemp;
  268.                writeln(#13,#10,'───ITERM: Phone directory entry made.───')
  269.           end;
  270.      end
  271.      else if valcode = 0 then
  272.      begin
  273.           CloseTemp;
  274.           DialModem(CurPhone)
  275.      end
  276. end;
  277. {$V+}
  278.